
{-# OPTIONS -XBangPatterns -fglasgow-exts #-}

module EngineTypes where

import RPTypes
import AtomMap
import Data.IntMap
import HistTree

import Control.Monad
import Data.Array.IO
import Data.IORef
import Data.Map (Map,empty,lookup,insert,fromList)
import Control.Monad.State
import Maybe
import System.Random
import Data.Bits
import Data.Word
import Foreign.Ptr
import Data.Int
import Foreign.C.Types

-- import Debug.Trace.Location

import qualified Data.Set as Set

type PWAMData = Ptr ()
type PICCount = Ptr ()


type WAMRef = Int

type TrailRef = Int

type WAMHeap a = IOArray WAMRef HEntry

type VarId = Int

type AtomRef = Data.IntMap.Key
type ClauseIDRef = Data.IntMap.Key

type HEntry = Int

-- Top 4 bits gives up 66 bits for arguments

emptyT = 0x00000000:: UnsignedNum
refT   = 0x10000000:: UnsignedNum
funcT  = 0x20000000:: UnsignedNum
prefT  = 0x30000000:: UnsignedNum
trefT  = 0x40000000:: UnsignedNum
csrefT = 0x50000000:: UnsignedNum
intT   = 0x60000000:: UnsignedNum

argmask   = 0x0FFFFFFF:: UnsignedNum
typemask  = 0xF0000000:: UnsignedNum
atommask  = 0x000FFFFF:: UnsignedNum
aritymask = 0x0FF00000:: UnsignedNum
signbit   = 0x08000000:: UnsignedNum

rawType :: UnsignedNum -> UnsignedNum
rawType x = ((x .&. typemask))

typeCheck :: UnsignedNum -> UnsignedNum -> Bool
typeCheck x t = (rawType x) == t

isHRef (x) = typeCheck x refT
isHFunc (x) = typeCheck x funcT
isHEmpty (x) = typeCheck x emptyT
isHInt (x) = typeCheck x intT

isHEmptyAndUninteresting x = x == 0

{-# INLINE deref1 #-}
deref1 (x) = x .&. argmask
getHRef x = deref1 x
derefprogref x = deref1 x
derefdebug _ x = deref1 x

derefInt :: HEntry -> Int
derefInt x = 
    let raw = x .&. argmask
	in if (raw .&. signbit) /= 0
	      then fromIntegral (raw .|. argmask)
	      else fromIntegral raw

getHFunc :: HEntry -> (AtomRef,Arity)
getHFunc (x) = (fromIntegral(atommask .&. x), fromIntegral ((aritymask .&. x) `shiftR` 20))

bt x t = ((x .|. t))
buildHRef x = bt x refT
buildHProgRef x = bt x prefT
buildHTrailRef x = bt x trefT
buildHCallStackRef x = bt x csrefT
buildHInt x = bt (fromIntegral x) intT

buildHEmpty = 0x0 :: HEntry

-- currently trusting that arity is <= 256 and less than 2^20 atoms in the system ...
buildHFunc :: AtomRef -> Arity -> HEntry
buildHFunc at ar = bt ((fromIntegral at) .|. ((fromIntegral ar) `shiftL` 20)) funcT

pentry h = 
    case (rawType h) of
    r| r == emptyT -> ("E " ++ ee)
     | r == funcT  -> ("F " ++ (show $ fst $ getHFunc h) ++ " " ++ (show $ snd $ getHFunc h))
     | r == refT   -> ("R " ++ ee)
     | r == prefT  -> ("P " ++ ee)
     | r == trefT -> ("T " ++ ee)
     | r == csrefT -> ("C " ++ ee)
     | r == intT -> ("I " ++ (show (derefInt r)))
     | otherwise -> "UNKNOWN"  -- should never happen
    where ee = (show (deref1 h))

apentry h am = 
    case (rawType h) of
    r| r == funcT  -> ("F " ++ (show $ fromJust (lookupAtom (fst $ getHFunc h) am)) ++ " " ++ (show $ snd $ getHFunc h))
     | otherwise -> (pentry h)  -- should never happen
    where ee = (show (deref1 h))

{-
instance Show HEntry where
-}
{-
-- Easy-to-debug data structure based interpreter

newtype HEntry = BLAH OldHEntry
data OldHEntry = 
	  HRef !WAMRef
	| HFunc AtomRef Arity
	| HProgRef UnsignedNum
	| HTrailRef UnsignedNum
	| HCallStackRef UnsignedNum
	| HEmpty
  deriving (Show, Eq)

buildHRef x = BLAH (HRef x)
buildHFunc at ar = BLAH (HFunc at ar)
buildHProgRef ref = BLAH (HProgRef ref)
buildHTrailRef ref = BLAH (HTrailRef ref)
buildHCallStackRef ref = BLAH (HCallStackRef ref)
buildHEmpty = BLAH (HEmpty)

isHRef (BLAH (HRef _)) = True
isHRef _ = False
isHFunc (BLAH (HFunc _ _)) = True
isHFunc _ = False
isHEmpty (BLAH HEmpty) = True
isHEmpty _ = False

getHRef (BLAH (HRef x)) = x
getHFunc (BLAH (HFunc at ar)) = (at,ar)

derefdebug :: UnsignedNum -> HEntry -> WAMRef
-- derefdebug n ref = (trace ("calling deref num " ++ (show n)) (deref1 ref))
derefdebug _ r = deref1 r

derefprogref (BLAH (HProgRef t)) = t

-- hacky for using aliases; everything maps to UnsignedNum
deref1 :: HEntry -> WAMRef
deref1 (BLAH (HRef ref)) = ref
deref1 (BLAH (HTrailRef ref)) = ref
deref1 (BLAH (HProgRef r)) = r
deref1 (BLAH (HCallStackRef r)) = r
-- deref1 x = trace ("ERROR IN DEREF1: " ++ (show x)) 0

instance Show HEntry where
    show (BLAH x) = ("D-" ++ (show x))

instance Eq HEntry where
    (BLAH x) == (BLAH y) = x == y
-}


-- (Int,Real) is number of entries; average of entries

newtype RTEntry = RTE ([ClauseIDRef],Int,Double)

newtype RandTable = RT (HistTree ClauseIDRef RTEntry, Int, Double,Double)  -- int here is depth, Double lambda scalePower

getWeight (RTE (_,_,w)) = w

getRT (RT (x,_,_,_)) = x
getDepth (RT (_,d,_,_)) = d
getLambda (RT (_,_,l,_)) = l
getScale (RT (_,_,_,p)) = p

instance Show RTEntry where
    show (RTE x) = "RTE " ++ (show x)

instance Show RandTable where
    show (RT x) = "RT " ++ (show x)


data TEntry = TE WAMRef HEntry
            | TEmpty
    deriving(Show)

data WAMOp =
    -- Standard WAMOPs
    Get_structure AtomRef Arity Register |     --  8 + 8 + 8 + 32 
    Put_structure AtomRef Arity Register |
    Unify_value Register |
    Unify_variable Register |
    Allocate Arity |
    Deallocate |
    Put_variable Register Register |
    Set_variable Register |
    Get_variable Register Register |
    Put_value Register Register |
    Set_value Register |
    Get_value Register Register |
    Call AtomRef Arity |
    Proceed |
    Try_here Arity WAMRef ClauseID |           -- 8 + 8 + 32     |      32 
    Retry_here WAMRef ClauseID |                -- 8 + 32     |      32
    Trust_here ClauseID |                        -- 8 + 32
    Try_there WAMRef Arity WAMRef ClauseID |  -- 8 + 32     | 32 + 32  
    Retry_there WAMRef WAMRef ClauseID |       -- 8 + 32     | 32 + 32
    Trust_there WAMRef ClauseID |               -- 8 + 32     |      32
    Neck_cut |
    Cut Register |
    Get_level Register |
    Branch WAMRef |
    -- RP Specials
    Randomize_try UnsignedNum | -- start of tries, end of tries, reference to table 
    Randomize_unweighted_try UnsignedNum | 
    Randomize_trust_there WAMRef ClauseID |     -- 8 + 32     |      32
    Random_neck UnsignedNum |
    Neck_offset WAMRef |
    RP_trust_here ClauseID |
    RP_trust_there  WAMRef ClauseID |           -- 8 + 32     |      32
    -- Bookkeeping
    HaltOP |
    NullOP |
    Try_there_alt WAMRef Arity WAMRef ClauseIDRef | 
    Retry_there_alt WAMRef WAMRef ClauseIDRef |
    Trust_there_alt WAMRef ClauseIDRef  |
    Randomize_trust_there_alt WAMRef ClauseIDRef
  deriving (Show,Eq)


type WAMOpRaw = Word64
type WAMOpRawUB = Word64
type WAMOpRawExternal = CULLong

{-# INLINE getop #-}
getop :: WAMOpRaw -> Word32
getop x = fromIntegral (((x .&. 0xFF00000000000000) :: WAMOpRaw) `shiftR` 56)

bitsop :: Word32 -> WAMOpRaw
bitsop x = (fromIntegral x) `shiftL` 56

{-# INLINE getwamrefinst #-}
getwamrefinst :: WAMOpRaw -> WAMRef
getwamrefinst !x = fromIntegral (x .&. 0x00000000FFFFFFFF :: WAMOpRaw)

bitswamrefinst :: WAMRef -> WAMOpRaw
bitswamrefinst x = (fromIntegral x) ::WAMOpRaw

{-# INLINE getwamrefanc2 #-}
getwamrefanc2 :: WAMOpRaw -> WAMRef
getwamrefanc2 !x = fromIntegral (x .&. 0x00000000FFFFFFFF :: WAMOpRaw)

bitswamrefanc2 :: WAMRef -> WAMOpRaw
bitswamrefanc2 x = (fromIntegral x) :: WAMOpRaw

{-# INLINE getwamrefanc1 #-}
getwamrefanc1 :: WAMOpRaw -> WAMRef
getwamrefanc1 !x = fromIntegral ((x .&. 0xFFFFFFFF00000000 :: WAMOpRaw) `shiftR` 32)

bitswamrefanc1 :: WAMRef -> WAMOpRaw
bitswamrefanc1 x = ((fromIntegral x) :: WAMOpRaw) `shiftL` 32 

{-# INLINE getcidinst #-}
getcidinst :: WAMOpRaw -> ClauseIDRef
getcidinst !x = fromIntegral (x .&. 0x00000000FFFFFFFF :: WAMOpRaw)

bitscidinst :: ClauseID -> (AtomMap ClauseID) -> WAMOpRaw
bitscidinst x cix = (fromIntegral$ fromJust $ AtomMap.lookupAtomRef x cix) :: WAMOpRaw

{-# INLINE getcidanc #-}
getcidanc :: WAMOpRaw -> ClauseIDRef
getcidanc = getcidinst
bitscidanc = bitscidinst

bitscidancalt :: ClauseIDRef -> WAMOpRaw
bitscidancalt x = (fromIntegral x) :: WAMOpRaw


{-# INLINE getatomrefinst #-}
getatomrefinst :: WAMOpRaw -> AtomRef
getatomrefinst !x = fromIntegral (x .&. 0x00000000FFFFFFFF :: WAMOpRaw)

bitsatomrefinst :: AtomRef -> WAMOpRaw
bitsatomrefinst x = (fromIntegral x) :: WAMOpRaw

{-# INLINE getarityinst #-}
getarityinst :: WAMOpRaw -> Arity
getarityinst !x = fromIntegral ((x .&. 0x00FF000000000000 :: WAMOpRaw) `shiftR` 48)

bitsarityinst :: Arity -> WAMOpRaw
bitsarityinst x = ((fromIntegral x) :: WAMOpRaw) `shiftL` 48 

{-# INLINE getreginst1 #-}
getreginst1 :: WAMOpRaw -> RegisterRaw
getreginst1 !x = fromIntegral  ((x .&. 0x000000FF00000000 :: WAMOpRaw) `shiftR` 32)

bitsreginst1 :: Register -> WAMOpRaw
bitsreginst1 x = ((fromIntegral $ registerToRaw x) :: WAMOpRaw) `shiftL` 32

{-# INLINE getreginst2 #-}
getreginst2 :: WAMOpRaw -> RegisterRaw
getreginst2 !x = fromIntegral  ((x .&. 0x00000000000000FF :: WAMOpRaw))

bitsreginst2 :: Register -> WAMOpRaw
bitsreginst2 x = (fromIntegral $ registerToRaw x) :: WAMOpRaw

op_nullop        = 0x00 :: Word32
op_haltop        = 0x01 :: Word32
op_get_structure = 0x02 :: Word32
op_put_structure = 0x03 :: Word32
op_unify_value   = 0x04 :: Word32
op_unify_variable= 0x05 :: Word32
op_allocate      = 0x06 :: Word32
op_deallocate    = 0x07 :: Word32
op_put_variable  = 0x08 :: Word32
op_set_variable  = 0x09 :: Word32
op_get_variable  = 0x0a :: Word32
op_put_value     = 0x0b :: Word32
op_set_value     = 0x0c :: Word32
op_get_value     = 0x0d :: Word32
op_call          = 0x0e :: Word32
op_proceed       = 0x0f :: Word32
op_neck_cut      = 0x10 :: Word32
op_cut           = 0x11 :: Word32
op_get_level     = 0x12 :: Word32
op_branch        = 0x13 :: Word32
op_randomize_try  = 0x14 :: Word32
op_randomize_unweighted_try   = 0x15 :: Word32
op_rp_trust_here   = 0x16 :: Word32
op_trust_here    = 0x17 :: Word32


op_try_here      = 0x80 :: Word32
op_retry_here    = 0x81 :: Word32
op_try_there      = 0x82 :: Word32
op_retry_there    = 0x83 :: Word32
op_trust_there    = 0x84 :: Word32
op_randomize_trust_there = 0x85 :: Word32
op_rp_trust_there    = 0x86 :: Word32

{-# INLINE isauxop #-}
isauxop :: WAMOpRaw -> Bool
isauxop x = (x .&. 0x8000000000000000) /= 0


wAMOpToWAMOpRaw :: WAMOp -> (AtomMap ClauseID) -> ( WAMOpRaw, WAMOpRaw )
wAMOpToWAMOpRaw (Get_structure aref arity reg) _ = ((bitsop op_get_structure) .|. (bitsatomrefinst aref) .|. 
						 (bitsarityinst arity) .|. (bitsreginst1 reg), 0x00)
wAMOpToWAMOpRaw (Put_structure aref arity reg) _ = ((bitsop op_put_structure) .|. (bitsatomrefinst aref) .|. 
						 (bitsarityinst arity) .|. (bitsreginst1 reg), 0x00)
wAMOpToWAMOpRaw (Unify_value reg) _ = ((bitsop op_unify_value) .|. (bitsreginst1 reg), 0x00)
wAMOpToWAMOpRaw (Unify_variable reg) _ = ((bitsop op_unify_variable) .|. (bitsreginst1 reg), 0x00)
wAMOpToWAMOpRaw (Allocate size) _ = ((bitsop op_allocate) .|. (bitsarityinst size), 0x00)
wAMOpToWAMOpRaw (Deallocate) _ = ((bitsop op_deallocate), 0x00)
wAMOpToWAMOpRaw (Put_variable reg1 reg2) _ = ((bitsop op_put_variable) .|. (bitsreginst1 reg1) .|. (bitsreginst2 reg2), 0x00)
wAMOpToWAMOpRaw (Set_variable reg) _ = ((bitsop op_set_variable) .|. (bitsreginst1 reg), 0x00)
wAMOpToWAMOpRaw (Get_variable reg1 reg2) _ = ((bitsop op_get_variable) .|. (bitsreginst1 reg1) .|. (bitsreginst2 reg2), 0x00)
wAMOpToWAMOpRaw (Put_value reg1 reg2) _ = ((bitsop op_put_value) .|. (bitsreginst1 reg1) .|. (bitsreginst2 reg2), 0x00)
wAMOpToWAMOpRaw (Set_value reg) _ = ((bitsop op_set_value) .|. (bitsreginst1 reg), 0x00)
wAMOpToWAMOpRaw (Get_value reg1 reg2) _ = ((bitsop op_get_value) .|. (bitsreginst1 reg1) .|. (bitsreginst2 reg2), 0x00)
wAMOpToWAMOpRaw (Call aref arity) _ = ((bitsop op_call) .|. (bitsatomrefinst aref) .|. 
						 (bitsarityinst arity), 0x00)
wAMOpToWAMOpRaw (Proceed) _ = ((bitsop op_proceed), 0x00)
wAMOpToWAMOpRaw (Trust_here cid) cix = ((bitsop op_trust_here) .|. (bitscidinst cid cix), 0x00)
wAMOpToWAMOpRaw (Cut reg) _ = ((bitsop op_cut) .|. (bitsreginst1 reg), 0x00)
wAMOpToWAMOpRaw (Neck_cut) _ = ((bitsop op_neck_cut), 0x00)
wAMOpToWAMOpRaw (Get_level reg) _ = ((bitsop op_get_level) .|. (bitsreginst1 reg), 0x00)
wAMOpToWAMOpRaw (Branch loc) _ = ((bitsop op_branch) .|. (bitswamrefinst loc), 0x00)
wAMOpToWAMOpRaw (Randomize_try size) _ = ((bitsop op_randomize_try) .|. (bitswamrefinst size), 0x00)
wAMOpToWAMOpRaw (Randomize_unweighted_try size) _ = ((bitsop op_randomize_unweighted_try) .|. (bitswamrefinst size), 0x00)
wAMOpToWAMOpRaw (RP_trust_here cid) cix = ((bitsop op_rp_trust_here) .|. (bitscidinst cid cix), 0x00)

-- **** --

wAMOpToWAMOpRaw (Try_here arity ref cid) cix = ((bitsop op_try_here) .|. (bitsarityinst arity) .|. (bitswamrefinst ref),
						 (bitscidanc cid cix))
wAMOpToWAMOpRaw (Retry_here ref cid) cix = ((bitsop op_retry_here) .|. (bitswamrefinst ref),
					     (bitscidanc cid cix))
wAMOpToWAMOpRaw (Try_there rref arity cref cid) cix = ((bitsop op_try_there) .|. (bitsarityinst arity) .|. (bitswamrefinst rref),
						        ((bitscidanc cid cix) .|. (bitswamrefanc1 cref)))
wAMOpToWAMOpRaw (Retry_there rref cref cid) cix = ((bitsop op_retry_there) .|. (bitswamrefinst rref),
						        ((bitscidanc cid cix) .|. (bitswamrefanc1 cref)))
wAMOpToWAMOpRaw (Trust_there rref cid) cix = ((bitsop op_trust_there) .|. (bitswamrefinst rref),
						        (bitscidanc cid cix))
wAMOpToWAMOpRaw (Randomize_trust_there rref cid) cix = ((bitsop op_randomize_trust_there) .|. (bitswamrefinst rref),
						        (bitscidanc cid cix))
wAMOpToWAMOpRaw (RP_trust_there rref cid) cix = ((bitsop op_rp_trust_there) .|. (bitswamrefinst rref),
						  (bitscidanc cid cix))
wAMOpToWAMOpRaw NullOP _ = ((bitsop op_nullop),0x00)
wAMOpToWAMOpRaw HaltOP _ = ((bitsop op_haltop),0x00)

-- **** --

wAMOpToWAMOpRawAlt (Try_there_alt rref arity cref cid)  = ((bitsop op_try_there) .|. (bitsarityinst arity) .|. (bitswamrefinst rref),
						       ((bitscidancalt cid ) .|. (bitswamrefanc1 cref)))
wAMOpToWAMOpRawAlt (Retry_there_alt rref cref cid)  = ((bitsop op_retry_there) .|. (bitswamrefinst rref),
						        ((bitscidancalt cid ) .|. (bitswamrefanc1 cref)))
wAMOpToWAMOpRawAlt (Trust_there_alt rref cid)  = ((bitsop op_trust_there) .|. (bitswamrefinst rref),
						        (bitscidancalt cid ))
wAMOpToWAMOpRawAlt (Randomize_trust_there_alt rref cid)  = ((bitsop op_randomize_trust_there) .|. (bitswamrefinst rref),
						        (bitscidancalt cid ))


-- wAMOpToWAMOpRaw t _ = failure assert (show t)

oRegStore = 11 :: UnsignedNum
oChoiceCut = 10 :: UnsignedNum
oOldCodeTop = 9 :: UnsignedNum
oCodeTop = 8 :: UnsignedNum
oSize = 7 :: UnsignedNum
oEnvp = 6 :: UnsignedNum
oContp = 5 :: UnsignedNum
oChoicep = 4 :: UnsignedNum
oNext = 3 :: UnsignedNum
oTrail = 2 :: UnsignedNum
oHeap = 1 :: UnsignedNum

data RWMode = Read | Write
  deriving Eq

type VarMap = (Map Variable Register)
type VarMapCount = (Map Variable (Register,Int))

type CallStackRef = UnsignedNum

data Builtin a = BI { builtin:: (WAMData a) -> IO () }

type CallStackEntry = (ClauseIDRef,ChoiceStyle,WAMRef)

data WAMData s = WT { heap :: (IOUArray WAMRef HEntry),
                      cWAMData :: PWAMData,
                      cInstCount :: PICCount,
                      cCallCount :: PICCount,
		      --heap :: (WAMHeap s),
                      code :: (IOUArray WAMRef WAMOpRawUB),
		      codeaux :: (IOUArray WAMRef WAMOpRawUB),
                      -- env :: (IOArray WAMRef HEntry),
                      heapTop :: !(IORef WAMRef),
                      codeTop :: !(IORef WAMRef),
                      envTop :: !(IORef WAMRef), -- actually the E pointer in WAMREF
                      choiceBottom :: !(IORef WAMRef), -- used to separate inductive and deductive phases
                      choice :: !(IORef WAMRef),
                      cutchoice :: !(IORef WAMRef),
                      dedchoice :: !(IORef WAMRef),
                      pc :: !(IORef WAMRef),
                      contp :: !(IORef WAMRef),
                      sreg :: !(IORef WAMRef),
                      heapSize :: !WAMRef,
                      codeSize :: !WAMRef,
                      mode :: !(IORef RWMode), 
                      callIndex :: !(IORef (Map (AtomRef,Arity) WAMRef)),
                      builtinIndex :: !(IORef (Map (AtomRef,Arity) (Builtin s))),
		      atomIndex :: (IORef (AtomMap Atom)),
		      clauseIDIndex :: (IORef (AtomMap ClauseID)),
                      queryResult :: !(IORef Bool),
		      -- special CIDS
		      exceptCID :: ClauseIDRef,
		      nullCID :: ClauseIDRef,
                      -- trail
                      trail :: !(IOArray TrailRef TEntry),
                      trailTop :: !(IORef TrailRef),
                      trailSize :: !TrailRef,
                      -- callstack
                      callstack :: !(IORef [CallStackEntry]),
		      weightMultiple :: !(IORef Int),
                      -- Needed at compile and decook, but not exec
                      variableMap :: !(IORef VarMap),
                      -- ransdtable
                      randTable :: !(IORef RandTable),
                      oldCodeTop :: !(IORef WAMRef),
		      pointChange :: !(IORef UnsignedNum),
		      origChange :: !(IORef ClauseIDRef),
                      -- NEXT ONES ARE COMPILE ONLY
                      argreg :: (IORef UnsignedNum),
                      permreg :: (IORef UnsignedNum),
                      tempreg :: (IORef UnsignedNum),
                      dedQuery :: (IORef CBody),
                      indQuery :: (IORef CBody),
                      -- RNG
                      sgen :: !(IORef StdGen),
                      randpreds :: !(IORef (Set.Set PredID)),
		      seed :: (IORef Int),
                      -- COUNTS
		      countsRunning :: (IORef Bool),
		      currTrialCount :: (IORef Int), --- XXX Can now be removed, doesn't work
                      indTrialCount :: (IORef Int),
		      restartThreshold :: (IORef Counter),
		      shortThreshold :: (IORef Counter),
		      -- DEBUG
		      traceall :: !(IORef Bool)}

data ChoiceStyle = Try | Trust
	deriving (Show,Eq)


data Register = 
      ArgRegister UnsignedNum 
    | PermRegister UnsignedNum
    | TempRegister UnsignedNum
    | NullRegister
  deriving (Eq)

type RegisterRaw = Word32

reg_type x = (x .&. 0x3) `shiftL` 6

{-
null_reg_t = reg_type 0x00 :: Word32
arg_reg_t = reg_type 0x01 :: Word32
perm_reg_t = reg_type 0x02 :: Word32
temp_reg_t = reg_type 0x02 :: Word32
-}

null_reg_t = 0x00 :: Word32
arg_reg_t = 0x40 :: Word32
perm_reg_t = 0x80 :: Word32
temp_reg_t = 0xc0 :: Word32

reg_type_bits x = (x .&. 0xc0)
reg_id_reverse :: RegisterRaw -> UnsignedNum
reg_id_reverse x = fromIntegral (x .&. 0x3F)

reg_id :: UnsignedNum -> Word32
reg_id x = fromIntegral (x .&. 0x3F)

registerToRaw :: Register -> RegisterRaw
registerToRaw NullRegister = 0x00
registerToRaw (ArgRegister x) = (arg_reg_t) .|. (reg_id x)
registerToRaw (PermRegister x) = (perm_reg_t) .|. (reg_id x)
registerToRaw (TempRegister x) = (temp_reg_t) .|. (reg_id x)

rawToRegister :: RegisterRaw -> Register
rawToRegister x =
    case (reg_type_bits x) of
    r | r == null_reg_t -> NullRegister
      | r == arg_reg_t -> ArgRegister (reg_id_reverse x)
      | r == perm_reg_t -> PermRegister (reg_id_reverse x)
      | r == temp_reg_t -> TempRegister (reg_id_reverse x)
    where prin = "MASK : " ++ (show $ reg_type_bits x) ++ " RAW: " ++ (show x) ++ "\n"


itempreg = (registerToRaw $ TempRegister (argRegSize - 1))
  
instance Show Register where
   show (ArgRegister r) = "A" ++ (show r)
   show (TempRegister r) = "X" ++ (show r)
   show (PermRegister r) = "Y" ++ (show r)
   show (NullRegister) = "NNN"


printCodeEntryInst ::  (WAMOpRaw) -> AtomMap ClauseID -> WAMOp
printCodeEntryInst code cix =
    case (getop code) of
    c | c == op_nullop -> NullOP
      | c == op_haltop -> HaltOP
      | c == op_get_structure -> Get_structure (getatomrefinst code) (getarityinst code) (rawToRegister $ getreginst1 code) 
      | c == op_put_structure -> Put_structure (getatomrefinst code) (getarityinst code) (rawToRegister (getreginst1 code)) 
      | c == op_unify_variable -> Unify_variable (rawToRegister $ getreginst1 code) 
      | c == op_unify_value -> Unify_value (rawToRegister $ getreginst1 code) 
      | c == op_allocate -> Allocate (getarityinst code) 
      | c == op_deallocate -> Deallocate 
      | c == op_put_variable -> Put_variable (rawToRegister$ getreginst1 code) (rawToRegister$ getreginst2 code) 
      | c == op_set_variable -> Set_variable (rawToRegister$ getreginst1  code) 
      | c == op_get_variable -> Get_variable (rawToRegister$ getreginst1  code) (rawToRegister$ getreginst2  code) 
      | c == op_put_value -> Put_value (rawToRegister$ getreginst1  code) (rawToRegister$ getreginst2  code) 
      | c == op_set_value -> Set_value (rawToRegister$ getreginst1  code) 
      | c == op_get_value -> Get_value (rawToRegister$ getreginst1  code) (rawToRegister$ getreginst2  code) 
      | c == op_call -> Call (getatomrefinst code) (getarityinst code) 
      | c == op_proceed -> Proceed 
      | c == op_trust_here -> Trust_here (fromJust $ lookupAtom (getcidinst code) cix)
      | c == op_cut -> Cut (rawToRegister$ getreginst1  code) 
      | c == op_neck_cut -> Neck_cut 
      | c == op_get_level -> Get_level (rawToRegister$ getreginst1  code) 
      | c == op_branch -> Branch (getwamrefinst code) 
      | c == op_randomize_try -> Randomize_try (getwamrefinst code)
      | c == op_randomize_unweighted_try -> Randomize_unweighted_try (getwamrefinst code)
      | otherwise -> undefined


printCodeEntryInstAux :: (WAMOpRaw) -> WAMOpRaw -> AtomMap ClauseID -> WAMOp
printCodeEntryInstAux  code aux cix=
    case (getop code) of
    c | c == op_try_here -> Try_here (getarityinst code) (getwamrefinst code) cid
      | c == op_retry_here -> Retry_here (getwamrefinst code) cid
      | c == op_try_there -> Try_there (getwamrefinst code) (getarityinst code) (getwamrefanc1 aux) cid
      | c == op_retry_there -> Retry_there (getwamrefinst code) (getwamrefanc1 aux) cid
      | c == op_trust_there -> Trust_there (getwamrefinst code) cid
      | c == op_randomize_trust_there -> Randomize_trust_there (getwamrefinst code) cid
      | otherwise -> undefined
    where cid = (fromJust $ lookupAtom (getcidanc aux) cix)

printCodeEntryInstAuxAlt :: (WAMOpRaw) -> WAMOpRaw -> WAMOp
printCodeEntryInstAuxAlt  code aux =
    case (getop code) of
    c | c == op_try_there -> Try_there_alt (getwamrefinst code) (getarityinst code) (getwamrefanc1 aux) (getcidanc aux)
      | c == op_retry_there -> Retry_there_alt (getwamrefinst code) (getwamrefanc1 aux) (getcidanc aux)
      | c == op_trust_there -> Trust_there_alt (getwamrefinst code) (getcidanc aux)
      | c == op_randomize_trust_there -> Randomize_trust_there_alt (getwamrefinst code) (getcidanc aux)
      | otherwise -> undefined
